Belgian Amiga Club - ADF Collection/BS1 part 05.zip/BS1 part 5/IM_3.adf/Exec/piarc.LZH/pmbc.rexx

OS/2 REXX Batch file | 1992-02-29 | 10KB | 378 lines

/*
 * PMBC.rexx
 *
 *  Written by: Ben Williams
 * Last Update: March 4th, 1992
 *    Revision: 1.05
 *         For: Black Belt Systems image processing series IM, IM F/c, and IP.
 */
parse arg var1
/*
 * open rexxsupport.library -- needed for some functions
 */
if ~show('L',"rexxsupport.library") then do
  if addlib('rexxsupport.library',0,-30,0) then do
      /* everything's ok */
    end;
  else do
    say 'We Have A Library Problem, Unable To Load "rexxsupport.library"';
    say 'Cannot operate PMBC.rexx without this library - sorry!';
    exit 10;
    end;
  end;
/*
 * This will automatically direct the script to the proper
 * software, if it is running. No matter where the script is
 * launched from. :^) I sure do like ARexx. :^))
 */
prtnme = 'IP_Port'; /* assume Image Professional */
if show('P','IP_Port') = 0 then do
  if show('P','IM_Port') = 0 then do
    say "Can't find image processor's ARexx port!!!"; /* not running? */
    say "This script requires IP, IM or IM F/c to run!";
    exit(20);
    end;
  else do
    prtnme = 'IM_Port'; /* That's the thing about assumptions... */
    end;                 /* We make em, user's break em.          */
  end;

  /*
   * This code attempts to read a file called "picmdpath" from REXX:
   * If it can't find it, the script will assume that the commands
   * associated with this PI Module are in "c:". If the file exists,
   * the script will look in the path that is specified in the file.
   * If you create this file, you MUST put a complete, correct path
   * in it; if the commands are in a sub-directory, you have to put
   * the trailing slash on the path (like, device:dir/).
   *
   */
  cmdpath = 'c:';
  if open(fhandle,'rexx:picmdpath','read') then  /* open the file */
    do
      cmdpath = readln(fhandle);
      call close(fhandle);  /* close the file    */
    end

/*
 * (Possibly) prompt user - load, or save?
 */
if var1 = 'load' then do
  pick = 1
  end
else if var1 = 'save' then do
  pick = 2
  end
else do
  address(prtnme);
  options results;
  'gadgets "Load","PMBC","Save","PMBC"';
  pick = result;
  options;
  address;
  end;

if pick=0 then do
  exit 0;
  end;

  options results;
  'gadgets "Show PMBC","Progress","Quiet",""';
  pmbcprogress = result-1;
  options;
  if pmbcprogress < 0 then do
    address;
    'tofront';
    exit 0;
    end

/*
 * PI driver for compressor
 */
if pick=2 then do /* compression */


  bufname = 'image';
  strn = ' -q ';
  address(prtnme);

  prevpath = 'ram:'; /* put user in ram to start with... */
  if show('C',pmbcpath) = 1 then do
    prevpath = getclip(pmbcpath);
    end;

  options results;
  'current';
  bufdata = result; /* get name of buffer, if there is one */
  parse var bufdata bname ',' bnum ',' bx ',' by ',' btot ',' bmem ',' bparname ',' bparnum;
  if bname ~= '<none>' then do
    bufname = bname;
    end;
  if (length(bufname) > 4) then do
    epos = pos('.pmbc',bufname,length(bufname)-4);
    if epos ~= 0 then do
      bufname = left(bufname,epos-1)
      end
    end;
  'filerequest "'||prevpath||'","'||bufname||'",".pmbc","Save PMBC"';
  pmbcfile = result;
  options;

  if pmbcfile = 'FR_CANCELLED' then do
    address(prtnme);
    'imtofront';
    exit 0;
    end;

call mungefilename(); /* make filename complete path */
thispath = gimmepath(pmbcfile);
call setclip(pmbcpath,thispath);

  address(prtnme);
  options results;
  'jackin';
  jackadr = result;
  options;

  'wbtofront';
  if pmbcprogress = 0 then do
    address command cmdpath||'wrpmbc -s -c -o "'||pmbcfile||'" -j '||jackadr;
    end;
  else do
    address command cmdpath||'wrpmbc -o "'||pmbcfile||'" -j '||jackadr;
    end;

  address(prtnme);
  'imtofront';
  address;

  exit 0;

  end;

else do /* decompression */

/*
 * Setup default path
 */
  prevpath = 'ram:'; /* put user in ram to start with... */
/*
 * Now, get old path if it exists
 */
  if show('C',pmbcpath) = 1 then do
    prevpath = getclip(pmbcpath);
    end;

  address(prtnme);
  options results;
  'current';
  bufdata = result; /* get name of buffer, if there is one */
  parse var bufdata bname ',' bnum ',' bx ',' by ',' btot ',' bmem ',' bparname ',' bparnum;
  if bname ~= '<none>' then do
    bufname = bname;
    end;
  if (length(bufname) > 4) then do
    epos = pos('.pmbc',bufname,length(bufname)-4);
    if epos ~= 0 then do
      bufname = left(bufname,epos-1)
      end
    end;
  'filerequest "'||prevpath||'","'||bufname||'",".pmbc","Load PMBC"';
  pmbcfile = result;
  options;

  if pmbcfile = 'FR_CANCELLED' then do
    address(prtnme);
    'imtofront';
    exit 0;
    end;

  call mungefilename();
  thispath = gimmepath(pmbcfile);
  call setclip(pmbcpath,thispath);

  fileinfo = statef(pmbcfile);
  parse var fileinfo fitype fibytes fiblocks fiflags fidays fimins fiticks ficomment;

  if fitype = '' then do
    'message Cannot locate "'pmbcfile'" for processing';
    exit 10;
    end;

  if fitype = 'DIR' then do
    'message Must specify a file, not a directory';
    exit 10;
    end;

/*
 * at this point, we have at least some assurance that we
 * have a real pmbc file to work with. Now, we need to look into
 * the file and see how big the image is, so we can open a new
 * buffer of the appropriate size.
 */

  call open(fhandle,pmbcfile,'read');    /* open the file     */
  offset = seek(fhandle,0,'B');          /* go to PMBC id     */
  filecode = readch(fhandle,4);          /* read in 'PMBC'    */

  offset = seek(fhandle,4,'B');          /* go to x dim       */
  width = c2d(readch(fhandle,1)) * 256;
  width = width + c2d(readch(fhandle,1));

  offset = seek(fhandle,6,'B');          /* go to y dim       */
  height = c2d(readch(fhandle,1)) * 256;
  height = height + c2d(readch(fhandle,1));

  call close(fhandle);                   /* close the file    */

  masked = 'NO';

  if filecode ~== 'PMBC' then do
    if filecode ~== 'PmBC' then do
      "message This is not a PMBC file!";
      exit 10;
      end;
    else do
      masked = 'YES';
      end;
    end;

  if height < 0 then do
    "message Bad height: "||height;
    exit 0;
    end;

  if height > 32767 then do
    "message Bad height: "||height;
    exit 0;
    end;

  if width < 0 then do
    "message Bad width: "||width;
    exit 0;
    end;

  if width > 32767 then do
    "message Bad width: "||width;
    exit 0;
    end;

  address(prtnme);

  'imtofront'; /* show user the IM screen */
  /* is there already a primary buffer??? */
  options results;
  'current';
  bufdata = result;
  options;

  parse var bufdata bname ',' bnum ',' bx ',' by ',' btot ',' bmem ',' bparname ',' bparnum
  if bname ~= '<none>' then do
    address(prtnme);
  options results;
  'askyn '||'"Replace Primary ['||bname||']" "New As Primary"'
  prefs = result;
  options;
  'autoredraw 0'; /* we do NOT want automatic redrawing */
  address;
  if prefs = 0 then do
    address(prtnme);
    'killbuff '||bnum; /* this kills the Primary Buffer */
    address;
    end;
  end;

  /* New buffer is created at current resolution */
  address(prtnme);
  options results;
  if masked = 'NO' then do
    'newbuf '||width||' '||height;
    end;
  else do
    'newbuf "'||width||'","'||height||'","","MASK"';
    end;
  if rc ~= 0 then do
    "message Can't allocate buffer!";
    exit 0;
    end;
  bnum = result;
  'newcurrent '||bnum;
  'rename '||bnum||' 'gxname;
  address;

  address(prtnme);
  options results;
  'jackin';
  jackadr = result;
  options;

  'wbtofront';
  'lockimage '||bnum;
  if pmbcprogress = 0 then do
    address command cmdpath||'rdpmbc -s -c -j '||jackadr||' -i "'||pmbcfile||'"';
    end;
  else do
    address command cmdpath||'rdpmbc  -j '||jackadr||' -i "'||pmbcfile||'"';
    end;
  'unlockimage '||bnum;

  address(prtnme);
  'imtofront';
  'autoredraw 1';
  'redraw';
  address;

  exit 0;

  end;

/*
 * gimmepath
 *
 * This takes the provided argument and sucks the path out of it, then
 * returns that path to the caller, sans file name.
 */
gimmepath:
  arg fullnamegx;
    tempgx = reverse(fullnamegx);
    lengx = length(fullnamegx);   /* get length of string */
    slashdex = index(tempgx,'/'); /* first occurance of '/' from right */
    colondex = index(tempgx,':');  /* first occurance of ':' from right */
    seploc = 0; /* assumes current dir, no path supplied */
    if slashdex ~= 0 then do /* we assume we are in a DIR */
      seploc = (lengx - slashdex)+1;
      end;
    else do
      if colondex ~= 0 then do /* we assume we are on a device */
        seploc = (lengx - colondex)+1;
        end;
      end;
  gxname = substr(fullnamegx,seploc+1); /* if you ever need it */
  gxpath = left(fullnamegx,seploc);
  return(gxpath);

/*
 * Since pmbc.rexx can't be expected to know where the CD of the user
 * is when this cmd is invoked, we have to check the path the user
 * provides - if it's not specified right from a root, then we have
 * to make it a complete specification from the root. That way, the
 * entire path is passed to pmbc.rexx. This is a very nice, generally
 * useful routine for this purpose. Note that it goes after a global
 * filename variable, and so could (should) be re-written to handle
 * parameters.
 */
mungefilename:
  if index(pmbcfile,':') = 0 then do
    curdir = pragma(D);
    if right(curdir,1) ~= ':' then do
      if right(curdir,1) ~= '/' then do
        if curdir ~= '' then do
          curdir = curdir || '/';
          end;
        end;
      end;
    pmbcfile = curdir||pmbcfile;
    end;
  return;